home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / dbase / reprtd.exe / REPTDOCS.CLA < prev    next >
Encoding:
Text File  |  1993-10-27  |  12.1 KB  |  410 lines
  1. REPTDOCS    PROGRAM
  2. REPTFILPATH STRING('\RRDOC\RPTSFILE.DAT')
  3. DTBSFILPATH STRING('\RRDOC\DTBSFILE.DAT')
  4. REPPATH        STRING(60)
  5. DBSPATH        STRING(60)
  6. DOSFILPATH  STRING(60)
  7. TBLRECS        LONG
  8. COUNTER        LONG
  9. RECS        LONG                 !  RECORDS() IN FILE
  10. REPT_TITLE   STRING(32)
  11. DTBS_TITLE   STRING(32)
  12.  
  13. NOPATH         EQUATE('PATH NOT FOUND')
  14. BAD_ACCESS   EQUATE('INVALID ACCESS CODE')
  15. BAD_DRIVE    EQUATE('INVALID DRIVE')
  16. CANT_DELETE  EQUATE('CANNOT DELETE CURRENT DIRECTORY')
  17. NO_FILES     EQUATE('NO MORE FILES')
  18. OPN_FILES    EQUATE('TOO MANY OPEN FILES')
  19.  
  20. DIRGRP         GROUP,PRE(GRP)
  21. DIRREC           GROUP
  22.          BYTE,DIM(21)             !USED BY NEXTDIR
  23. ATTRIB         BYTE                 !FILE ATTRIBUTE IN DOS FORMAT
  24. TIME         SHORT                 !FILE TIME IN DOS FORMAT
  25. DATE         SHORT                 !FILE DATE IN DOS FORMAT
  26. FILESIZE     LONG                 !FILE SIZE IN BYTES
  27. NAME         STRING(13)             !FILENAME
  28. PORS         STRING(9)             !PREVIOUS OR SUBDIRECTORY
  29.          . .
  30. DIRTBL         TABLE,PRE(TBL)
  31. DIRREC           GROUP
  32.          BYTE,DIM(21)             !USED BY NEXTDIR
  33. ATTRIB         BYTE                 !FILE ATTRIBUTE IN DOS FORMAT
  34. TIME         SHORT                 !FILE TIME IN DOS FORMAT
  35. DATE         SHORT                 !FILE DATE IN DOS FORMAT
  36. FILESIZE     LONG                 !FILE SIZE IN BYTES
  37. NAME         STRING(10)             !FILENAME
  38. EXT         STRING(3)             !FILE EXTENSION
  39. PORS         STRING(9)             !PREVIOUS OR SUBDIRECTORY
  40.          . .
  41.  
  42. SORTTBL         TABLE,PRE(SRT)             !SORT TABLE
  43. TBLREC           BYTE                 !  TABLE RECORD
  44. SORTSTR           STRING(30)             !  SORT STRING
  45.          .
  46.  
  47.    INCLUDE('STD_KEYS.CLA')
  48.    INCLUDE('CTL_KEYS.CLA')
  49.    INCLUDE('ALT_KEYS.CLA')
  50.    INCLUDE('SHF_KEYS.CLA')
  51.    MAP
  52.            PROC(G_RUNPROC)
  53.            MODULE('DOS1'),BINARY         !DOS LANGUAGE EXTENSION
  54.          PROC(SPOOL)             !  SPOOL DISK FILE TO PRINTER
  55.          PROC(SETDIR)             !  SET FOR DIRECTORY PROCESSING
  56.          PROC(NEXTDIR)             !  GET NEXT DIRECTORY ENTRY
  57.          PROC(REMOVEDIR)         !  REMOVE (DELETE) DIRECTORY
  58.          PROC(MAKEDIR)             !  MAKE NEW DIRECTORY
  59.          PROC(GODOS)             !  GO TO DOS PROMPT
  60.          PROC(BOOT)             !  SOFTWARE BOOT
  61.          FUNC(COMMAND_LINE),STRING     !  RETURN COMMAND LINE
  62.          FUNC(ENVIRONMENT),STRING     !  RETURN ENVIRONMENT VARIABLE
  63.            .
  64.    .
  65.  
  66. REJECT_KEY   EQUATE(CTRL_ESC)
  67. ACCEPT_KEY   EQUATE(CTRL_ENTER)
  68. TRUE         EQUATE(1)
  69. FALSE         EQUATE(0)
  70.  
  71. DOSFILE         DOS,NAME(DOSFILPATH),PRE(DFL)
  72.       RECORD
  73. DOS_STRING   STRING(150)
  74.      ..
  75.  
  76. REPTFILE   FILE,NAME(REPTFILPATH),PRE(RPT),CREATE
  77. RPKEY       KEY(RPT:REPT_TITLE),DUP
  78.        RECORD
  79. REPT_TITLE   STRING(32)
  80. DTBS_TITLE   STRING(32)
  81. DOS_NAME     STRING(14)
  82.        ..
  83.  
  84.  
  85. DTBSFILE   FILE,NAME(DTBSFILPATH),PRE(DBS),CREATE
  86. DBKEY       KEY(DBS:DTBS_TITLE),DUP
  87.        RECORD
  88. DTBS_TITLE   STRING(32)
  89. DOS_NAME     STRING(14)
  90.        ..
  91.  
  92.  
  93. SCREEN         screen       pre(SCN),hue(7,0)
  94.         row(1,1)   string('╔═{78}╗')
  95.         row(2,1)   repeat(15);string('║<0{78}>║') .
  96.         row(17,1)  string('╠═{78}╣')
  97.         row(18,1)  repeat(7);string('║<0{78}>║') .
  98.         row(25,1)  string('╚═{18}<0{13}>═{12}<0{18}>═{17}╝')
  99.         row(2,24)  string('Report Writer Documentation Utility')
  100.         row(3,32)  string('(c) 1993 Alan Young')
  101.         row(5,10)  string('Takes Report Writer Report Files and Database Files and creates')
  102.         row(6,10)  string('a database including a list of:')
  103.         row(8,6)   string('Report Name, Report Dos File Name, Data Base Name, Data Base File '    |
  104.                   & 'Name')
  105.         row(10,16) string('Please type in path for Report Writer Report Files')
  106.         row(14,14) string('Please type in path for Report Writer Definition files')
  107.         row(23,35) string('Count=')
  108.         row(25,20) string('CTRL-ESC=EXIT')
  109.            col(45) string('CTRL-ENTER=PROCEED')
  110.         row(12,11) entry(@S60),use(reppath),ovr,req,lft,upr
  111.         row(16,11) entry(@S60),use(dbspath),lft,upr
  112. MESSAGE        row(19,19) string(45)
  113. MESSAGE2    row(21,11) string(60)
  114. count        row(23,41) string(@n07)
  115.          .
  116.  
  117. ERRWIN         SCREEN      WINDOW(3,54),AT(23,14),HUE(7,1,0)
  118.  OMIT('**-END-**')
  119.          ╟────────────────────────────────────────────────────╢
  120.          ║■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■║
  121.          ╚════════════════════════════════════════════════════╝
  122. **-END-**
  123.  
  124.            ROW(1,1)      STRING('╟─{52}╢'),ENH
  125.            ROW(2,1)      STRING('║<0{52}>║'),ENH
  126.            ROW(3,1)      STRING('╚═{52}╝'),ENH
  127. ERRMESS           ROW(2,2)      STRING(52),REV,BLK
  128.          .
  129.        CODE
  130.  
  131.          open(SCREEN)
  132.            loop
  133.           UPDATE
  134.           DISPLAY
  135.           ALERT
  136.           ALERT(Accept_Key)
  137.           ALERT(Reject_Key)
  138.           accept
  139.           kc#=keycode()
  140.           if kc#       = reject_key then
  141.            close(SCREEN)
  142.            return
  143.           .    ! if
  144.           if kc#       = accept_key then break.
  145.            .  ! loop
  146.            update
  147.  
  148.            if clip(reppath)=''
  149.          beep
  150.          BEEP
  151.          show(25,1,'ERROR - NO REPORT PATH - PRESS A KEY                                       ')
  152.          ask
  153.          return
  154.            .
  155.            if clip(DBSPATH)=''
  156.          beep
  157.          BEEP
  158.          show(25,1,'ERROR - NO REPORT PATH - PRESS A KEY                                       ')
  159.          ask
  160.          return
  161.            .
  162.  
  163.        !******************* READ REPORT FILES****************
  164.  
  165.      SETPATH(REPPATH)
  166.      SCN:MESSAGE='READING REPORTS DIRECTORY'
  167.      DISPLAY
  168.      DO GET_FILES
  169.      TBLRECS=RECORDS(DIRTBL)
  170.      CREATE(REPTFILE)
  171.      ERR#=errorcode()
  172.      IF ERR# <> 0
  173.  
  174.          show(25,1,'ERROR'&FORMAT(ERR#,@n3)&' - UNABLE TO CREATE FILE - PRESS A KEY            ')
  175.          ask
  176.          return
  177.      .
  178.      SCN:MESSAGE='COPYING REPORTS LIST TO A FILE'
  179.      DISPLAY
  180.      LOOP COUNTER=1 TO TBLRECS
  181.        scn:count=counter
  182.        display (scn:count)
  183.        GET(DIRTBL,COUNTER)
  184.        IF GRP:PORS <> '<<SUB DIR>'      |           !IF NOT PRE DIRECTORY
  185.        AND GRP:PORS <> '<<PRE DIR>'      |           !AND NOT SUB DIRECTRY
  186.        AND TBL:EXT <> '.DAT'      |
  187.        AND TBL:EXT <> '.K01'      |
  188.          THEN
  189.            RPT:DOS_NAME=UPPER(clip(TBL:NAME)&'.'&clip(TBL:EXT))
  190.            SCN:MESSAGE2=RPT:DOS_NAME
  191.            DISPLAY(RPT:DOS_NAME)
  192.            if clip(rpt:dos_name) <> '\...'
  193.           ADD(REPTFILE)
  194.            .
  195.        .
  196.      .
  197.  
  198.        scn:message='FINISHED READING REPORT FILES'
  199.        scn:message2=''
  200.        DISPLAY
  201.        close(reptfile)
  202.  
  203.        set(reptfile)
  204.        scn:message='GETTING REPORT TITLES'
  205.        DISPLAY
  206.        counter=0
  207.        loop while not eof(reptfile)
  208.       NEXT(reptfile)
  209.       counter+=1
  210.       scn:count=counter
  211.       display(SCN:COUNT)
  212.       DOSFILPATH=CLIP(REPPATH)&'\'&CLIP(RPT:DOS_NAME)
  213.       SET(DOSFILE)
  214.       if errorcode()=0
  215.           NEXT(DOSFILE)
  216.           if errorcode()=0
  217.         REPT_TITLE =UPPER(SUB(DFL:DOS_STRING,001,32))
  218.         DTBS_TITLE =UPPER(SUB(DFL:DOS_STRING,116,32))
  219.         RPT:REPT_TITLE = REPT_TITLE
  220.         RPT:DTBS_TITLE = DTBS_TITLE
  221.         scn:message2=RPT:REPT_TITLE&'|'&RPT:DTBS_TITLE
  222.         DISPLAY(SCN:MESSAGE2)
  223.         PUT(REPTFILE)
  224.         CLOSE(DOSFILE)
  225.          ELSE
  226.         BEEP
  227.         SCN:MESSAGE2='ERROR READING '&DOSFILPATH
  228.         DELETE(REPTFILE)    ! REMOVE INVALID ENTRIES
  229.         DISPLAY
  230.          .
  231.      CLOSE(DOSFILE)
  232.     ..
  233.     !*********************************************************
  234.     !now rEAD DATA BASE DEFINITION FILES
  235.      SETPATH(DBSPATH)
  236.      SCN:MESSAGE='READING DATA BASE DEFINITION DIRECTORY ' & DBSPATH
  237.      DISPLAY
  238.      DO GET_FILES
  239.      TBLRECS=RECORDS(DIRTBL)
  240.      CREATE(DTBSFILE)
  241.      ERR#=errorcode()
  242.      IF ERR# <> 0
  243.  
  244.          show(25,1,'ERROR'&FORMAT(ERR#,@n3)&' - UNABLE TO CREATE FILE - PRESS A KEY            ')
  245.          ask
  246.          return
  247.      .
  248.      SCN:MESSAGE='COPYING DATA BASE LIST TO A FILE'
  249.      DISPLAY
  250.      LOOP COUNTER=1 TO TBLRECS
  251.        scn:count=counter
  252.        display (scn:count)
  253.        GET(DIRTBL,COUNTER)
  254.        IF GRP:PORS <> '<<SUB DIR>'      |           !IF NOT PRE DIRECTORY
  255.        AND GRP:PORS <> '<<PRE DIR>'      |           !AND NOT SUB DIRECTRY
  256.        AND TBL:EXT <> '.DAT'      |
  257.        AND TBL:EXT <> '.K01'      |
  258.          THEN
  259.            DBS:DOS_NAME=UPPER(clip(TBL:NAME)&'.'&clip(TBL:EXT))
  260.            SCN:MESSAGE2=DBS:DOS_NAME
  261.            DISPLAY(DBS:DOS_NAME)
  262.            if clip(DBS:dos_name) <> '\...'
  263.           ADD(DTBSFILE)
  264.            .
  265.        .
  266.      .
  267.  
  268.        scn:message='FINISHED READING DATA BASE DEFINITION FILES'
  269.        scn:message2=''
  270.        DISPLAY
  271.        close(DTBSfile)
  272.  
  273.        set(DTBSfile)
  274.        scn:message='GETTING DATA BASE TITLES'
  275.        DISPLAY
  276.        counter=0
  277.        loop while not eof(DTBSfile)
  278.       NEXT(DTBSfile)
  279.       counter+=1
  280.       scn:count=counter
  281.       display(SCN:COUNT)
  282.       DOSFILPATH=CLIP(DBSPATH)&'\'&CLIP(DBS:DOS_NAME)
  283.       SET(DOSFILE)
  284.       if errorcode()=0
  285.           NEXT(DOSFILE)
  286.           if errorcode()=0
  287.         DTBS_TITLE =UPPER(SUB(DFL:DOS_STRING,001,32))
  288.         DBS:DTBS_TITLE = DTBS_TITLE
  289.         scn:message2=DBS:DTBS_TITLE
  290.         DISPLAY(SCN:MESSAGE2)
  291.         PUT(DTBSFILE)
  292.         CLOSE(DOSFILE)
  293.          ELSE
  294.         BEEP
  295.         SCN:MESSAGE2='ERROR READING '&DOSFILPATH
  296.         DELETE(DTBSFILE)   ! REMOVE INVALID ENTRIES
  297.         DISPLAY
  298.          .
  299.      CLOSE(DOSFILE)
  300.     ..
  301.  
  302.        SCN:MESSAGE2='COMPLETED READING DATABASE TITLES'
  303.        DISPLAY
  304.        ASK
  305.        close(DTBSfile)
  306.        close(screen)
  307.  
  308.        ! SORT FILES
  309.        G_RUNPROC('CSRT I=\RRDOC\RPTSFILE.DAT O=\RRDOC\RPTSFILE.DAT C=N D=N N=N /V')
  310.        G_RUNPROC('CSRT I=\RRDOC\DTBSFILE.DAT O=\RRDOC\DTBSFILE.DAT C=N D=N N=N /V')
  311.        G_RUNPROC('RRUN A=\RRDOC\REPTDOC.ARF')
  312.  
  313.  
  314.        !   R=\RRDOC\REPTDOC.RPT
  315.        !   D=\RRDOC\REPTDOC.DEF
  316.        !   C=\RRDOC\MATRIX.CTL
  317.        !   O="P-LPT1"
  318.        !   T=\RRDOC
  319.  
  320.  
  321.  
  322. GET_FILES    ROUTINE
  323.  
  324.   FREE(DIRTBL)                     !FREE DIRECTORY TABLE
  325.   DIR" = PATH()                     !ASSIGN CURRENT PATH
  326.   IF LEN(CLIP(DIR")) <> 3             !IF PATH 3 CHARS 'X:\'
  327.     ROOT" = 'NO'                 !  RESET ROOT DIRECTORY FLAG
  328.     DIR"  = CLIP(DIR") & '\*.*'             !  SET PATH TO ALL FILES
  329.     R#      = 2                     !  SET DIR ENTRY POINTER
  330.   ELSE                         !OTHERWISE
  331.     ROOT" = 'YES'                 !  SET ROOT FLAG
  332.     DIR"  = CLIP(DIR") & '*.*'             !  SET PATH TO ALL FILES
  333.     R#      = 1                     !  SET DIR ENTRY POINTER
  334.   .                         !END IF
  335.   SETDIR(DIR",DIRGRP)                 !SET PATTERN FOR DIRECTORY
  336.   RECS = 0                     !CLEAR # RECORDS
  337.   DRECS# = 0                     !CLEAR # DIRECTORY RECORDS
  338.   TOTSIZE# = 0                     !CLEAR TOTAL SIZE
  339.   counter=0
  340.   LOOP                         !LOOP THRU DIRECTORY
  341.     counter +=1
  342.     scn:count=counter
  343.     display
  344.     NEXTDIR(DIRGRP)                 !  GET A DIRECTORY ENTRY
  345.     GRP:PORS = ''                 !  CLEAR PREVIOUS OR SUB
  346.     IF ERROR() =  NO_FILES THEN BREAK.         !  END LOOP IF NO MORE FILES
  347.     IF GRP:NAME = '.' THEN CYCLE.         !  IF PREVIOUS DIR THEN CYCLE
  348.     RECS += 1                     !  INCREMENT RECORD COUNTER
  349.     IF BAND(GRP:ATTRIB,10H)             !  IF ENTRY IS PRE OR SUB DIR
  350.       IF GRP:NAME = '..'             !    IF PREVIOUS DIRECTORY
  351.     GRP:NAME = '\.. '             !    DISPLAY PREV SYMBOL
  352.     GRP:PORS = '<<PRE DIR>'             !    DISPLAY PREVIOUS
  353.       ELSE                     !    OTHERWISE
  354.     GRP:NAME = '\' & GRP:NAME         !    DISPLAY SUBDIRECTORY
  355.     GRP:PORS = '<<SUB DIR>'             !    DISPLAY SUB
  356.       .                         !    END IF
  357.       DRECS# += 1                 !    INCREMENT DIRECTORY COUNT
  358.     .                         !  END IF
  359.     TBL:DIRREC = GRP:DIRREC             !  ASSIGN GROUP TO TABLE
  360.       DOT# = INSTRING('.',GRP:NAME,1)               !GET DOT POSITION
  361.       IF GRP:PORS  <> '<<SUB DIR>'      |           !IF NOT PRE DIRECTORY
  362.       AND GRP:PORS <> '<<PRE DIR>'      |           !AND NOT SUB DIRECTRY
  363.       AND DOT#       <> 0                       !AND FILE HAS AN EXT
  364.     TBL:NAME = SUB(GRP:NAME,1,DOT#-1)           ! ASSIGN FILE NAME
  365.     TBL:EXT = SUB(GRP:NAME,INSTRING('.',GRP:NAME)+1,3) ! ASSIGN FILE EXT
  366.       ELSE                           !OTHERWISE
  367.     TBL:NAME = GRP:NAME                   ! ASSIGN NAME
  368.     TBL:EXT = ''                       ! CLEAR EXT
  369.       .                               !END IF
  370.     SCN:MESSAGE2=TBL:NAME&'.'&TBL:EXT
  371.     display
  372.  
  373.     IF TBL:PORS = '<<SUB DIR>'             !  IF A SUBDIRECTORY
  374.       ADD(DIRTBL,R#)                 !    ADD ENTRY AT BEGINNING
  375.       R# += 1                     !    INCREMENT RECORD POSITION
  376.     ELSE
  377.       ADD(DIRTBL)                 !  ADD TO TABLE
  378.     .
  379.     IF ERROR()                     !  IF THERE WAS AN ERROR
  380.       DO ERROR_RTN                 !    DISPLAY ERROR MESSAGE
  381.     .                         !  END IF
  382.     TOTSIZE# += GRP:FILESIZE             !  INCREMENT SIZE COUNTER
  383.   .                         !END LOOP
  384.  
  385.   IF ~RECS THEN RETURN.                 !IF NO RECORDS THEN GOTO MENU.
  386.  
  387. ERROR_RTN    ROUTINE
  388.  
  389.   OPEN(ERRWIN)                     !    OPEN ERROR WINDOW
  390.   BEEP                         !    BEEP SPEAKER
  391.   ERRMESS = ERROR() & ' - Press any key'     !    DISPLAY ERROR MESSAGE
  392.   ERRMESS = CENTER(ERRMESS)             !    CENTER ERROR MESSAGE
  393.   ASK                         !    WAIT FOR A KEYSTROKE
  394.   CLOSE(ERRWIN)                     !    CLOSE ERROR WINDOW
  395.  
  396.  
  397. G_RunProc    PROCEDURE(DosProg)             !Global Run Procedure
  398. DosProg         STRING(150)             !Program To Run
  399.  
  400. Screen2         screen       window(25,80),at(1,1),hue(15,1,0)
  401.          .
  402.  
  403.      CODE
  404.      OPEN(Screen2)                 !Save Current Screen
  405.      show(25,1,center(dosprog,78))
  406.      SetCursor(25,1)             !Position Cursor At Bottom
  407.      RUN(clip(DosProg))             !Run Dos Program
  408.      show(25,1,'                                                                              ')
  409.      CLOSE(Screen2)                 !Restore Screen
  410.